home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / elecTemplates.tcl < prev    next >
Encoding:
Text File  |  1997-12-17  |  16.7 KB  |  606 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "elecTemplates.tcl"
  6.  #                                      created: 24/2/97 {1:34:29 pm}    
  7.  #                                  last update: 17/12/97 {4:25:52 pm}    
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #  Routines for electric insertions, and keeping track of template
  15.  #  positions.    
  16.  # ###################################################################
  17.  ##
  18.  
  19. alpha::extension betterTemplates 9.0b4 {
  20.     alpha::package require elecBindings 9.0b1
  21.     alpha::useElectricTemplates
  22.     lunion varPrefs(Electrics) [list "Better Templates:" stopNavigationMsgOff \
  23.       templateStopColor maxTemplateNesting \
  24.       TemplatePrompts TemplateWrappers]
  25.     # colour of template stops (magenta default)
  26.     newPref var templateStopColor 4 global "" alpha::basiccolors varindex
  27.     # level of nesting we allow before clearing
  28.     newPref var maxTemplateNesting 5
  29.     ## 
  30.      # The format of the template stops:
  31.      #       0 = just    use    bullets
  32.      #       1 = use bullets but signal the name in the status window
  33.      #       2 = insert names    into the window    with the bullets
  34.      #       3 = insert names and highlight into the window with the bullets
  35.      ##
  36.     newPref var TemplatePrompts 1 global "" [list {Just use bullets} \
  37.         {Use bullets and status window prompt} {Put prompts in the text} \
  38.         {Highlight prompts in the text}] index
  39.     newPref var TemplateWrappers 0 global ring::_changeTemplateWrappers \
  40.         [list {<Angle brackets>} {“Curly quotes”} {«Curly brackets»} ] index
  41.     newPref flag stopNavigationMsgOff 0
  42.     ring::setTemplateMessage
  43.     # setup template wrappers
  44.     ring::_changeTemplateWrappers
  45.     # call on close to clear the stop ring.
  46.     hook::register closeHook ring::unsetName
  47. } maintainer {
  48.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  49. } uninstall this-file help {file "ElecCompletions Help"} disable {
  50.     source ${HOME}:Tcl:SystemCode:templates.tcl
  51. }
  52.  
  53. # we don't want to be auto-loaded unless we're active.
  54. if ![package::active betterTemplates] { 
  55.     alertnote "Something's trying to auto-load the betterTemplates extension\
  56.       but it's not active!"
  57.     return 
  58. }
  59.  
  60. # indicates we're a better ring
  61. proc ring::type {} { return 1 }
  62.  
  63. ## 
  64.  # -------------------------------------------------------------------------
  65.  # 
  66.  # "ring::getTMarkPos" --
  67.  # 
  68.  #  This procedure is pretty slow, due to limitations in Alpha.  Hopefully
  69.  #  one day we'll have a hard-wired quick version.  It also works around
  70.  #  a bug in which Alpha tells us that windows which aren't files (e.g.
  71.  #  just created with 'new -n') are located in Alpha's 'pwd' directory.
  72.  #  
  73.  #  The stupid thing is that Alpha knows exactly where each stop is, but
  74.  #  it won't tell us!  'gotoTMark $m' goes to exactly the position we
  75.  #  want, but we can't find it out some other way.
  76.  # -------------------------------------------------------------------------
  77.  ##
  78. proc ring::getTMarkPos {m} {
  79.     regexp {(.*) <[0-9]+>$} [set f [win::Current]] dmy f
  80.     if [file exists $f] {
  81.         if [regexp "\{$m \{[quote::Regfind $f]\} (\[0-9\]+) \[0-9\]+\}" [getTMarks] dummy where] {
  82.             return $where
  83.         }
  84.     } else {
  85.         if [regexp "\{$m \{[quote::Regfind [pwd]$f]\} (\[0-9\]+) \[0-9\]+\}" [getTMarks] dummy where] {
  86.             return $where
  87.         }
  88.     }
  89.     error "No such mark"
  90. }
  91.  
  92. proc ring::isTMarkAt {p} {
  93.     regexp {(.*) <[0-9]+>$} [set f [win::Current]] dmy f
  94.     if [file exists $f] {
  95.         if [regexp "\{(stop\[0-9\]+:\[0-9\]+) \{[quote::Regfind $f]\} $p $p\}" [getTMarks] dummy which] {
  96.             return $which
  97.         }
  98.     } else {
  99.         if [regexp "\{(stop\[0-9\]+:\[0-9\]+) \{[quote::Regfind [pwd]$f]\} $p $p\}" [getTMarks] dummy which] {
  100.             return $which
  101.         }
  102.     }
  103.     return ""
  104. }
  105.  
  106. proc ring::isNested {p} {
  107.     if {![catch {ring::minmax} mm] && $p >= [lindex $mm 0] && $p <= [lindex $mm 1]} {
  108.         return 1
  109.     } else {
  110.         ring::clear
  111.         return 0
  112.     }
  113. }
  114.  
  115. proc ring::nestedPos {pos} {
  116.     if [catch {
  117.         if {$pos < [ring::getTMarkPos nestStart]} { return -1 }
  118.         if {$pos > [ring::getTMarkPos nestEnd]} { return -1 }
  119.     }] { return -1 }
  120.     set positions [ring::orderAndPositions max]
  121.     if {$positions == "" || $pos < [lindex $positions 0] || $pos >= $max} {
  122.         return -1
  123.     } else {
  124.         set i 0
  125.         while {$pos >= [lindex $positions $i]} {incr i}
  126.         return $i
  127.     }
  128. }
  129.  
  130. proc ring::minmax {} {
  131.     return [list [ring::getTMarkPos nestStart] [ring::getTMarkPos nestEnd]]
  132. }
  133. proc ring::list {} {
  134.     # get a local reference to the window's stopRing
  135.     upvar \#0 __elecRing([ring::winName]) s
  136.     if ![info exists s] {
  137.         return [ring::clear]
  138.     }
  139.     set s
  140. }
  141.  
  142. proc ring::clear {} {
  143.     set x [ring::winName]
  144.     # get a local reference to the window's stopRing
  145.     upvar \#0 __elecRing($x) s
  146.     if {[info exists s] && $s != ""} {
  147.         ring::_ensure_no_bullets $s
  148.     }
  149.     set s ""
  150.     upvar \#0 __elecRingPrompts$x w
  151.     catch {unset w}
  152.     global __elecNestingLevel __elecLastStop
  153.     set __elecNestingLevel($x) 0
  154.     set __elecLastStop($x) ""
  155.     
  156.     removeTMark "nestStart"
  157.     removeTMark "nestEnd"
  158. }
  159.  
  160. proc ring::unsetName {name} {
  161.     ring::unseti [join [file tail $name] ""]
  162. }
  163.  
  164. proc ring::unseti {x} {
  165.     global __elecRing __elecNestingLevel __elecLastStop __elecRingPrompts$x
  166.     catch {unset __elecRing($x)}
  167.     catch {unset __elecNestingLevel($x)}
  168.     catch {unset __elecLastStop($x)}
  169.     catch {unset __elecRingPrompts$x}
  170. }
  171.  
  172. proc ring::_ensure_no_bullets {stops} {
  173.     message "Deleting non-nested prompts…"
  174.     createTMark "_deleting_" [getPos]
  175.     foreach stop $stops {
  176.         if ![catch {ring::getTMarkPos $stop} p] {
  177.             ring::_deleteBullet $p
  178.             removeTMark $stop
  179.         }    
  180.     }
  181.     message ""
  182.     gotoTMark "_deleting_"
  183.     removeTMark "_deleting_"
  184. }
  185.  
  186. ## 
  187.  # -------------------------------------------------------------------------
  188.  # 
  189.  # "ring::replaceStopMatches" --
  190.  # 
  191.  #  Replace all stops which match 'stoppat' (a simple glob like pattern)
  192.  #  with the text '$text'.  The stops are permanently deleted.
  193.  # -------------------------------------------------------------------------
  194.  ##
  195. proc ring::replaceStopMatches {stoppat text} {
  196.     # get a local reference to the window's stopRing
  197.     set x [ring::winName]
  198.     upvar \#0 __elecRing($x) s
  199.     if [info exists s] {
  200.         pushPosition
  201.         upvar \#0 __elecRingPrompts$x w
  202.         set i 0
  203.         foreach stop $s {
  204.             if [string match $stoppat $w($stop)] {
  205.                 if ![catch {ring::getTMarkPos $stop} p] {
  206.                     if [ring::_deleteBullet $p] {
  207.                         insertText $text
  208.                     }
  209.                     removeTMark $stop
  210.                     set s [lreplace $s $i $i]
  211.                     incr i -1
  212.                 }    
  213.             }
  214.             incr i
  215.         }    
  216.         popPosition
  217.     } else {
  218.         ring::clear
  219.     } 
  220. }
  221.  
  222. proc ring::winName {} { return [join [win::CurrentTail] ""] }
  223.  
  224. proc ring::order {} {
  225.     # get a local reference to the window's stopRing
  226.     upvar \#0 __elecRing([ring::winName]) s
  227.     if [info exists s] {
  228.         for {set i 0} {$i <100} {incr i} {
  229.             if { [set lpos [lsearch -exact $s stop0:${i}]] != -1 } {
  230.                 set s [concat [lrange $s $lpos end] [lrange $s 0 [incr lpos -1]]]
  231.                 return $s
  232.             }
  233.         }
  234.     } else {
  235.         ring::clear
  236.     } 
  237. }
  238.  
  239. proc ring::orderAndPositions {{mx ""}} {
  240.     # get a local reference to the window's stopRing
  241.     upvar \#0 __elecRing([ring::winName]) s
  242.     if {[info exists s] && ([string trim $s] != {}) } {
  243.         if {$mx != ""} { upvar $mx max }
  244.         set max -1
  245.         foreach st $s {
  246.             if {[set p [ring::getTMarkPos $st]] > $max} {
  247.                 set max $p
  248.             }
  249.             lappend positions $p
  250.         }
  251.         set lpos [lsearch -exact $positions $max]
  252.         set s [concat [lrange $s [expr $lpos +1] end] [lrange $s 0 $lpos]]
  253.         set positions [concat [lrange $positions [expr $lpos +1] end] \
  254.           [lrange $positions 0 $lpos]]
  255.         return $positions
  256.     } else {
  257.         ring::clear
  258.         return ""
  259.     } 
  260. }
  261.  
  262. ## 
  263.  # -------------------------------------------------------------------------
  264.  # 
  265.  # "ring::_deleteBullet" --
  266.  # 
  267.  #  Deletes the bullet and a following tag-prompt.  The mark moves to the
  268.  #  location of the deleted text (side-effect).  Returns '1' if the deletion
  269.  #  was successful, else '0'.
  270.  # -------------------------------------------------------------------------
  271.  ##
  272. proc ring::_deleteBullet {p {h 0}} {
  273.     if {[lookAt $p] == "•"} {
  274.         global ring::_tstart ring::_tmatch
  275.         if {[lookAt [expr $p +1]] == ${ring::_tstart} } {
  276.             set    ppos [search -s -f 1 -r 1 -l [expr $p + 80] -n ${ring::_tmatch} $p]
  277.             if { [lindex $ppos 0] == $p } {
  278.                 if $h {
  279.                     eval select $ppos
  280.                 } else {
  281.                     eval deleteText $ppos
  282.                 }
  283.                 return 1
  284.             }
  285.         }
  286.         deleteText $p [incr p]
  287.         return 1
  288.     }
  289.     return 0
  290. }
  291.  
  292. proc ring::_goto {rest} {
  293.     global __elecLastStop ring::_templateMessage TemplatePrompts
  294.     set x [ring::winName]
  295.     gotoTMark [set __elecLastStop($x) $rest]
  296.     # remove the stop '•' plus optional prompt-tag.
  297.     ring::_deleteBullet [getPos] [expr $TemplatePrompts == 3]
  298.     if $TemplatePrompts {
  299.         upvar \#0 __elecRingPrompts$x w
  300.         if {$w($rest) != ""} {
  301.             message "Fill in '$w($rest)'${ring::_templateMessage}"
  302.         } else {
  303.             message "Fill in template stop${ring::_templateMessage}"
  304.         }
  305.     }
  306. }
  307.  
  308. proc ring::nth {} {
  309.     # get a local reference to the window's stopRing
  310.     set x [ring::winName]
  311.     upvar \#0 __elecRing($x) s
  312.     upvar \#0 __elecRingPrompts$x w
  313.     foreach f $s {
  314.         if {$w($f) != ""} {
  315.             lappend l "$f -- $w($f)"
  316.         } else {
  317.             lappend l "$f -- (no prompt)"
  318.         }
  319.     }
  320.     if ![info exists l] { beep; message "No template stops exist." }
  321.     set item [lindex [listpick -p "Pick a stop (listed from current pos)…" $l] 0]
  322.     ring::goto $item
  323. }
  324. proc ring::goto {stop} {
  325.     # get a local reference to the window's stopRing
  326.     upvar \#0 __elecRing([ring::winName]) s
  327.     if [info exists s] {
  328.         if { [set lpos [lsearch -exact $s $stop]] != -1 } {
  329.             set s [concat [lrange $s $lpos end] [lrange $s 0 [incr lpos -1]]]
  330.             ring::_goto $stop
  331.         }
  332.     } else {
  333.         ring::clear
  334.     } 
  335. }
  336.  
  337. ## 
  338.  # -------------------------------------------------------------------------
  339.  # 
  340.  # "ring::TMarkAt" --
  341.  # 
  342.  #  Is the template stop with prompt 'name' at position 'pos'.  The 'name'
  343.  #  is the name of the enclosed prompt as in '•environment name•', but
  344.  #  without the bullets.  It is matched via 'string match'.
  345.  # -------------------------------------------------------------------------
  346.  ##
  347. proc ring::TMarkAt {name pos} {
  348.     set stop [ring::isTMarkAt $pos]
  349.     if {$stop != ""} {
  350.         set x [ring::winName]
  351.         upvar \#0 __elecRingPrompts$x w
  352.         return [string match $name $w($stop)]
  353.     } else {
  354.         return 0
  355.     }
  356. }
  357.  
  358. proc ring::+ {} {
  359.     # get a local reference to the window's stopRing
  360.     upvar \#0 __elecRing([ring::winName]) s
  361.     set first [lindex $s 0]
  362.     set s [lreplace $s 0 0]
  363.     lappend s $first
  364.     set next [lindex $s 0]
  365.     ring::_goto $next
  366. }
  367. proc ring::- {} {
  368.     # get a local reference to the window's stopRing
  369.     upvar \#0 __elecRing([ring::winName]) s
  370.     set end [expr [llength $s] - 1]
  371.     set last [lindex $s $end]
  372.     set s [lreplace $s $end $end]
  373.     set s [linsert $s 0 $last]
  374.     ring::_goto $last
  375. }
  376.  
  377. proc ring::deleteBulletAndMove {} {
  378.     ring::_deleteBullet [getPos]
  379.     ring::+
  380. }
  381.  
  382. proc ring::deleteStopAndMove {} {
  383.     ring::_deleteStop
  384.     upvar \#0 __elecRing([ring::winName]) s
  385.     ring::_goto [lindex $s 0]
  386. }
  387.  
  388. proc ring::deleteStop {} {
  389.     ring::_deleteStop
  390. }
  391.  
  392. proc ring::_deleteStop {} {
  393.     global __elecLastStop
  394.     set x [ring::winName]
  395.     # get a local reference to the window's stopRing
  396.     upvar \#0 __elecRing($x) s
  397.     set l [lsearch -exact $s $__elecLastStop($x)]
  398.     if {$l != -1 } {
  399.         global TemplatePrompts
  400.         if {$TemplatePrompts == 3} {
  401.             ring::_deleteBullet [getPos]
  402.         }
  403.         set s [lreplace $s $l $l]
  404.         removeTMark $__elecLastStop($x)
  405.         set __elecLastStop($x) ""
  406.     }
  407. }
  408.  
  409. proc ring::insert {rest {goto 1}} {
  410.     global __elecNestingLevel __elecCurrentNesting maxTemplateNesting
  411.     # get a local reference to the window's stopRing
  412.     set x [ring::winName]
  413.     upvar \#0 __elecRing($x) s
  414.     # if not nested, clear everything
  415.     if {[set p [ring::nestedPos [getPos]]] == "-1" \
  416.         || [incr __elecNestingLevel($x)] > $maxTemplateNesting } {
  417.         ring::clear
  418.         set p 0
  419.     }
  420.     set _level $__elecNestingLevel($x)
  421.     # preliminaries
  422.     set pos [getPos]
  423.     set ii [set i 0] 
  424.     upvar \#0 __elecRingPrompts$x w
  425.     global __elecPrompts
  426.     if ![info exists __elecPrompts] {
  427.         set __elecPrompts ""
  428.     }
  429.     # do the stop ring, extracting prompts from '__elecPrompts'
  430.     while {[regexp -indices "•" $rest I] == 1} {
  431.         regsub "•" $rest "o" rest
  432.         createTMark "stop${_level}:$i" [expr $pos + [lindex $I 0]]
  433.         lappend ss "stop${_level}:$i"
  434.         set w(stop${_level}:$i) [lindex $__elecPrompts $i]
  435.         #set __elecPrompts [lrange $__elecPrompts 1 end]
  436.         incr i
  437.     }
  438.     if {$i > 2 || ($i == 2 && $_level == 0)} {
  439.         # store insertion's min and max, if we have more than two stops
  440.         createTMark "nestStart" $pos
  441.         createTMark "nestEnd" [expr $pos + [string length $rest]]
  442.     }
  443.     # put the stop ring together
  444.     set s [concat $ss [lrange $s $p end] [lrange $s 0 [expr $p -1]]]
  445.     # forget the prompt list (we've stored them in an array)
  446.     unset __elecPrompts
  447.     # goto the first stop we just inserted
  448.     if $goto {
  449.         ring::_goto "stop${_level}:${ii}"
  450.     }
  451. }
  452.  
  453.  
  454. proc ring::_changeTemplateWrappers {{flag ""}} {
  455.     global flag::list TemplateWrappers
  456.     set wrap [lindex [lindex [set flag::list(TemplateWrappers)] 1] $TemplateWrappers]
  457.     global ring::_tstart ring::_tend ring::_tmatch
  458.     set a [string index $wrap 0]
  459.     set b [string index $wrap [expr [string length $wrap] -1]]
  460.     
  461.     set "ring::_tstart" $a
  462.     set "ring::_tend" $b
  463. #     set "ring::_tmatch" "•${a}\[^${a}${b}\]*${b}"
  464.     set "ring::_tmatch" "(•${a}\[^${a}${b}]*${b}|•${a}(\[^${a}${b}\]*(${a}\[^${a}${b}\]*${b})\[^${a}${b}\]*)*${b})"
  465. }
  466.  
  467. proc ring::setTemplateMessage {} {
  468.     global electricBindings    ring::_templateMessage stopNavigationMsgOff
  469.     set ring::_templateMessage [lindex \
  470.         {", press (shift)-Tab to move to the next (previous) stop." \
  471.         ", press (shift)-ctrl-j to move to the next (previous) stop." \
  472.         ", press user-defined keys to move from stop to stop." } \
  473.         $electricBindings]
  474.     if {$stopNavigationMsgOff} {
  475.         set ring::_templateMessage ""
  476.     } 
  477. }
  478.  
  479.  
  480.  
  481. ## 
  482.  # -------------------------------------------------------------------------
  483.  #     
  484.  #    "elec::_Insertion" --
  485.  #    
  486.  #     Insert    a piece    of text, padding on    the    left appropriately.     The text 
  487.  #     should    already    be correctly indented within itself.  
  488.  # -------------------------------------------------------------------------
  489.  ##
  490. proc elec::_Insertion { center args } {
  491.     global __elecPrompts TemplatePrompts
  492.     set text [join $args ""]
  493.     set pos [getPos]
  494.     regsub -all "\t" $text [text::Tab] text
  495.     if [regexp "\[\n\r\]" $text] {
  496.         regsub -all "\[\n\r\]" $text "\r[text::indentTo $pos]" text
  497.     }
  498.     if [regexp "…" $text] {
  499.         regsub -all "…" $text [text::halfTab] text
  500.     }
  501.     if {![regexp "•" $text] || ([regexp {^([^•]*)••$} $text "" text])} {
  502.         setMark
  503.         insertText $text
  504.         if $center { centerRedraw }
  505.         return
  506.     }
  507.     switch $TemplatePrompts {
  508.         0 {
  509.             set t $text
  510.             regsub -all {•[^•]*•} $text "•" text
  511.             insertText $text
  512.             while {[regexp {^([^•]*)•([^•]*)•(.*)$} $t dmy tt hyper t]} {
  513.                 lappend __elecPrompts $hyper
  514.             }
  515.         }
  516.         1 {
  517.             while {[regexp {^([^•]*)•([^•]*)•(.*)$} $text dmy tt hyper text]} {
  518.                 lappend __elecPrompts $hyper
  519.                 append t "${tt}•"
  520.                 lappend colours [list [string length $tt] 1]
  521.             }
  522.             append t $text
  523.         }
  524.         2 -
  525.         3 {
  526.             global ring::_tstart ring::_tend
  527.             while {[regexp {^([^•]*)•([^•]*)•(.*)$} $text dmy tt hyper text]} {
  528.                 lappend __elecPrompts $hyper
  529.                 if {$hyper != ""} {
  530.                     append t "${tt}•${ring::_tstart}${hyper}${ring::_tend}"
  531.                     lappend colours [list [string length $tt] [expr 3 + [string length $hyper]]]
  532.                 } else {
  533.                     append t "${tt}•"
  534.                     lappend colours [list [string length $tt] 1]
  535.                 }
  536.             }
  537.             append t $text
  538.         }
  539.     }
  540.     if $TemplatePrompts {
  541.         set p $pos
  542.         # we insert in one chunk so undoing is easy.
  543.         insertText $t
  544.         global templateStopColor
  545.         if {$templateStopColor} {
  546.             foreach col $colours {
  547.                 insertColorEscape [incr p [lindex $col 0]] $templateStopColor
  548.                 insertColorEscape [incr p [lindex $col 1]] 0
  549.             }
  550.         }
  551.         
  552.         set text $t
  553.     }
  554.     
  555.     goto $pos
  556.     if $center { centerRedraw }
  557.     ring::insert $text
  558. }
  559.  
  560.  
  561. # ◊◊◊◊ possible tab key bindings ◊◊◊◊ #
  562. # note: Also provided by the base Alpha system, these overide when 
  563. # Univs Completions package is in use (these may be more intricate).
  564.  
  565. ## 
  566.  # -------------------------------------------------------------------------
  567.  #     
  568.  #    "bind::IndentOrNextstop" --
  569.  #    
  570.  #     Either    insert a real tab if your mode hasn't defined its electricTab
  571.  #     variable, or jump to the next template    stop (if we're mid-template),
  572.  #     or    indent the current line    correctly.
  573.  # -------------------------------------------------------------------------
  574.  ##
  575. proc bind::IndentOrNextstop {{hard 0}} {
  576.     if {$hard || ![elec::_haveTab] } {
  577.         insertActualTab 
  578.     } else {
  579.         global tabNeverIndents
  580.         if {[info exists tabNeverIndents] && $tabNeverIndents} { return [ring::+] }
  581.         if [ring::isNested [getPos]] {
  582.             ring::+
  583.         } else {
  584.             bind::IndentLine
  585.         }
  586.     }
  587. }
  588.  
  589. ## 
  590.  # -------------------------------------------------------------------------
  591.  #     
  592.  #    "bind::TabOrComplete" --
  593.  #    
  594.  #     Either    insert a real tab if your mode hasn't defined its electricTab
  595.  #     variable, or invoke the completion mechanism, or indent the current 
  596.  #     line correctly.
  597.  # -------------------------------------------------------------------------
  598.  ##
  599. proc bind::TabOrComplete {{hard 0}} {
  600.     if {$hard || ![elec::_haveTab] } {
  601.         insertActualTab 
  602.     } else {
  603.         bind::Completion
  604.     }
  605. }
  606.